home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / perl5 / Debconf / DbDriver.pm < prev    next >
Text File  |  2008-10-10  |  2KB  |  113 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::DbDriver;
  6. use Debconf::Log qw{:all};
  7. use strict;
  8. use base 1.01; # ensure that they don't have a broken perl installation
  9.  
  10.  
  11.  
  12. use fields qw(name readonly required backup failed
  13.               accept_type reject_type accept_name reject_name);
  14.  
  15. our %drivers;
  16.  
  17.  
  18. sub new {
  19.     my Debconf::DbDriver $this=shift;
  20.     unless (ref $this) {
  21.         $this = fields::new($this);
  22.     }
  23.     $this->{required}=1;
  24.     $this->{readonly}=0;
  25.     $this->{failed}=0;
  26.     my %params=@_;
  27.     foreach my $field (keys %params) {
  28.         if ($field eq 'readonly' || $field eq 'required' || $field eq 'backup') {
  29.             $this->{$field}=1,next if lc($params{$field}) eq "true";
  30.             $this->{$field}=0,next if lc($params{$field}) eq "false";
  31.         }
  32.         elsif ($field=~/^(accept|reject)_/) {
  33.             $this->{$field}=qr/$params{$field}/i;
  34.         }
  35.         $this->{$field}=$params{$field};
  36.     }
  37.     unless (exists $this->{name}) {
  38.         $this->{name}="(unknown)";
  39.         $this->error("no name specified");
  40.     }
  41.     $drivers{$this->{name}} = $this;
  42.     $this->init;
  43.     return $this;
  44. }
  45.  
  46.  
  47. sub init {}
  48.  
  49.  
  50. sub error {
  51.     my $this=shift;
  52.  
  53.     if ($this->{required}) {
  54.         warn('DbDriver "'.$this->{name}.'":', @_);
  55.         exit 1;
  56.     }
  57.     else {
  58.         warn('DbDriver "'.$this->{name}.'" warning:', @_);
  59.     }
  60. }
  61.  
  62.  
  63. sub driver {
  64.     my $this=shift;
  65.     my $name=shift;
  66.     
  67.     return $drivers{$name};
  68. }
  69.  
  70.  
  71. sub accept {
  72.     my $this=shift;
  73.     my $name=shift;
  74.     my $type=shift;
  75.     
  76.     return if $this->{failed};
  77.     
  78.     if ((exists $this->{accept_name} && $name !~ /$this->{accept_name}/) ||
  79.         (exists $this->{reject_name} && $name =~ /$this->{reject_name}/)) {
  80.         debug "db $this->{name}" => "reject $name";
  81.         return;
  82.     }
  83.  
  84.     if (exists $this->{accept_type} || exists $this->{reject_type}) {
  85.         if (! defined $type || ! length $type) {
  86.             my $template = Debconf::Template->get($this->getfield($name, 'template'));
  87.             return 1 unless $template; # no type to act on
  88.             $type=$template->type || '';
  89.         }
  90.         return if exists $this->{accept_type} && $type !~ /$this->{accept_type}/;
  91.         return if exists $this->{reject_type} && $type =~ /$this->{reject_type}/;
  92.     }
  93.  
  94.     return 1;
  95. }
  96.  
  97.  
  98. sub ispassword {
  99.     my $this=shift;
  100.     my $item=shift;
  101.  
  102.     my $template=$this->getfield($item, 'template');
  103.     return unless defined $template;
  104.     $template=Debconf::Template->get($template);
  105.     return unless $template;
  106.     my $type=$template->type || '';
  107.     return 1 if $type eq 'password';
  108.     return 0;
  109. }
  110.  
  111.  
  112. 1
  113.